home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_Tix.idb / usr / freeware / lib / tix4.1 / HListDD.tcl.z / HListDD.tcl
Encoding:
Text File  |  1999-01-26  |  4.2 KB  |  200 lines
  1. # HListDD.tcl --
  2. #
  3. #    !!! PRE-ALPHA CODE, NOT USED, DON'T USE !!!
  4. #
  5. #    This file implements drag+drop for HList.
  6. #
  7. # Copyright (c) 1996, Expert Interface Technologies
  8. #
  9. # See the file "license.terms" for information on usage and redistribution
  10. # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  11. #
  12.  
  13. #
  14. # events
  15. #
  16. #
  17.  
  18. proc tixHListSingle:DragTimer {w ent} {
  19.     case [tixHListSingle:GetState $w] {
  20.     {1} {
  21.         # fire up
  22.     }
  23.     }
  24. }
  25.  
  26.  
  27.  
  28.  
  29.  
  30. #----------------------------------------------------------------------
  31. #
  32. #            Drag + Drop Bindings
  33. #
  34. #----------------------------------------------------------------------
  35.  
  36.          #----------------------------------------#
  37.          #              Sending Actions          #
  38.          #----------------------------------------#
  39.  
  40. #----------------------------------------------------------------------
  41. #  tixHListSingle:Send:WaitDrag --
  42. #
  43. #    Sender wait for dragging action
  44. #----------------------------------------------------------------------
  45. proc tixHListSingle:Send:WaitDrag {w x y} {
  46.     global tixPriv
  47.  
  48.     set ent [tixHListSingle:GetNearest $w $y]
  49.     if {$ent != ""} {
  50.     $w anchor set $ent
  51.     $w select clear
  52.     $w select set $ent
  53.  
  54.     set tixPriv(dd,$w:moved) 0
  55.     set tixPriv(dd,$w:entry) $ent
  56.  
  57. #    set browsecmd [$w cget -browsecmd]
  58. #    if {$browsecmd != "" && $ent != ""} {
  59. #        eval $browsecmd $ent
  60. #    }
  61.     }
  62. }
  63.  
  64. proc tixHListSingle:Send:StartDrag {w x y} {
  65.     global tixPriv
  66.     set dd [tixGetDragDropContext $w]
  67.  
  68.     if {![info exists tixPriv(dd,$w:entry)]} {
  69.     return
  70.     }
  71.     if {$tixPriv(dd,$w:entry) == ""} {
  72.     return
  73.     }
  74.  
  75.     if {$tixPriv(dd,$w:moved) == 0} {
  76.     $w dragsite set $tixPriv(dd,$w:entry)
  77.     set tixPriv(dd,$w:moved) 1
  78.     $dd config -source $w -command "tixHListSingle:Send:Cmd $w"
  79.     $dd startdrag $X $Y
  80.     } else {
  81.     $dd drag $X $Y
  82.     }
  83. }
  84.  
  85. proc tixHListSingle:Send:DoneDrag {w x y} {
  86.     global tixPriv
  87.     global moved
  88.  
  89.     if {![info exists tixPriv(dd,$w:entry)]} {
  90.     return
  91.     }
  92.     if {$tixPriv(dd,$w:entry) == ""} {
  93.     return
  94.     }
  95.  
  96.     if {$tixPriv(dd,$w:moved) == 1} {
  97.     set dd [tixGetDragDropContext $w]
  98.     $dd drop $X $Y
  99.     }
  100.     $w dragsite clear
  101.     catch {unset tixPriv(dd,$w:moved)}
  102.     catch {unset tixPriv(dd,$w:entry)}
  103. }
  104.  
  105. proc tixHListSingle:Send:Cmd {w option args} {
  106.     set dragCmd [$w cget -dragcmd]
  107.     if {$dragCmd != ""} {
  108.     return [eval $dragCmd $option $args]
  109.     }
  110.  
  111.     # Perform the default action
  112.     #
  113.     case "$option" {
  114.     who {
  115.         return $w
  116.     }
  117.     types {
  118.         return {data text}
  119.     }
  120.     get {
  121.         global tixPriv
  122.         if {[lindex $args 0] == "text"} {
  123.         if {$tixPriv(dd,$w:entry) != ""} {
  124.             return [$w entrycget $tixPriv(dd,$w:entry) -text]
  125.         }
  126.         }
  127.         if {[lindex $args 0] == "data"} {
  128.         if {$tixPriv(dd,$w:entry) != ""} {
  129.             return [$w entrycget $tixPriv(dd,$w:entry) -data]
  130.         }
  131.         }
  132.     }
  133.     }
  134. }
  135.  
  136.          #----------------------------------------#
  137.          #              Receiving Actions          #
  138.          #----------------------------------------#
  139. proc tixHListSingle:Rec:DragOver {w sender x y} {
  140.     if {[$w cget -selectmode] != "dragdrop"} {
  141.     return
  142.     }
  143.  
  144.     set ent [tixHListSingle:GetNearest $w $y]
  145.     if {$ent != ""} {
  146.     $w dropsite set $ent
  147.     } else {
  148.     $w dropsite clear
  149.     }
  150. }
  151.  
  152. proc tixHListSingle:Rec:DragIn {w sender x y} {
  153.     if {[$w cget -selectmode] != "dragdrop"} {
  154.     return
  155.     }
  156.     set ent [tixHListSingle:GetNearest $w $y]
  157.     if {$ent != ""} {
  158.     $w dropsite set $ent
  159.     } else {
  160.     $w dropsite clear
  161.     }
  162. }
  163.  
  164. proc tixHListSingle:Rec:DragOut {w sender x y} {
  165.     if {[$w cget -selectmode] != "dragdrop"} {
  166.     return
  167.     }
  168.     $w dropsite clear
  169. }
  170.  
  171. proc tixHListSingle:Rec:Drop {w sender x y} {
  172.     if {[$w cget -selectmode] != "dragdrop"} {
  173.     return
  174.     }
  175.     $w dropsite clear
  176.  
  177.     set ent [tixHListSingle:GetNearest $w $y]
  178.     if {$ent != ""} {
  179.     $w anchor set $ent
  180.     $w select clear
  181.     $w select set $ent
  182.     }
  183.  
  184.     set dropCmd [$w cget -dropcmd]
  185.     if {$dropCmd != ""} {
  186.     eval $dropCmd $sender $x $y
  187.     return
  188.     }
  189.  
  190. #    set browsecmd [$w cget -browsecmd]
  191. #    if {$browsecmd != "" && $ent != ""} {
  192. #    eval $browsecmd [list $ent]
  193. #    }
  194. }
  195.  
  196. tixDropBind TixHListSingle <In>   "tixHListSingle:Rec:DragIn %W %S %x %y"
  197. tixDropBind TixHListSingle <Over> "tixHListSingle:Rec:DragOver %W %S %x %y"
  198. tixDropBind TixHListSingle <Out>  "tixHListSingle:Rec:DragOut %W %S %x %y"
  199. tixDropBind TixHListSingle <Drop> "tixHListSingle:Rec:Drop %W %S %x %y"
  200.